Cream of the Crop 22/Cream of the Crop 22.iso/program/ctlib100.zip/INSTALL.LZH/DATA.PAS

Pascal/Delphi Source File | 1996-10-12 | 19KB | 487 lines

{**************************************************************************}
{*  BitSoft Development, L.L.C.                                           *}
{*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
{*  All rights reserved.                                                  *}
{**************************************************************************}

unit Data;

interface

uses Objects,
     BsdTypes,
     ctBiTree, ctCollec, Types, ctLists;

function CreateString (Key : String5; Index : Integer) : Pointer;
{ Function used to create strings that will be inserted in string
  containers. }

type
  PTestRec = ^TTestRec;
  TTestRec = record
    Key : String5;
    Index : Integer;
  end; { TTestRec }

function CreateTestRec (Key: String5; Index: Integer) : pointer;
{ Function used to create items of type TTestRec. }

procedure CreateNonDynamicTestRec (Key: String5; Index: Integer; var Data);
{ Procedure used to initialize a non-dynamically allocated TTestRec record. }

type
  PTestObject = ^TTestObject;
  TTestObject = object(TObject)
      Text : PString;
      Index : Integer;
    constructor Init(Key : String5; AIndex : Integer);
    constructor Load(var S: TStream);
    procedure Store(var S: TStream);
    destructor Done; virtual;
  end; { TTestObject }

function CreateTestObject (Key: String5; Index: Integer) : pointer;
{ Function used to create items of type TTestObject. }

procedure CreateNonDynamicTestObject (Key: String5; Index: Integer; var Data);
{ Procedure used to initialize a non-dynamically allocated TTestObject. }

type
  PTestStaticObject = ^TTestStaticObject;
  TTestStaticObject = object(TObject)
      Text : String5;
      Index : Integer;
    constructor Init(Key : String5; AIndex : Integer);
    constructor Load(var S: TStream);
    procedure Store(var S: TStream);
  end; { TTestStaticObject }

function CreateStaticObject (Key: String5; Index: Integer) : pointer;
{ Function used to create items of type TTestStaticObject. }

procedure CreateNonDynamicTestStaticObject (Key: String5; Index: Integer;
  var Data);
{ Procedure used to initialize a non-dynamically allocated
  TTestStaticObject. }

type
  PTestListNode = ^TTestListNode;
  TTestListNode = object(TStringListNode)
      Index : Integer;
    constructor Init(Key : String5; AIndex : Integer);
    constructor Load(var S: TStream);
    procedure Store(var S: TStream);
  end; { TTestListNode }

function CreateListNode (Key: String5; Index: Integer) : pointer;
{ Function used to create items of type TTestListNode. }

type
  PTestDoubleNode = ^TTestDoubleNode;
  TTestDoubleNode = object(TStringDoubleNode)
      Index : Integer;
    constructor Init(Key : String5; AIndex : Integer);
    constructor Load(var S: TStream);
    procedure Store(var S: TStream);
  end; { TTestDoubleNode }

function CreateDoubleNode (Key: String5; Index: Integer) : pointer;
{ Function used to create items of type TTestDoubleNode. }

type
  PTestBinaryNode = ^TTestBinaryNode;
  TTestBinaryNode = object(TStringBinaryNode)
      Index : Integer;
    constructor Init(Key : String5; AIndex : Integer);
    constructor Load(var S: TStream);
    procedure Store(var S: TStream);
  end; { TTestBinaryNode }

function CreateBinaryNode (Key: String5; Index: Integer) : pointer;
{ Function used to create items of type TTestBinaryNode. }

type
  PTestAVLNode = ^TTestAVLNode;
  TTestAVLNode = object(TStringAVLNode)
      Index : Integer;
    constructor Init(Key : String5; AIndex : Integer);
    constructor Load(var S: TStream);
    procedure Store(var S: TStream);
  end; { TTestAVLNode }

function CreateAVLNode (Key: String5; Index: Integer) : pointer;
{ Function used to create items of type TTestAVLNode. }

const
  RTestBinaryNode : TStreamRec = (
    ObjType : idTestBinaryNode;
    VmtLink : Ofs(TypeOf(TTestBinaryNode)^);
    Load    : @TTestBinaryNode.Load;
    Store   : @TTestBinaryNode.Store);

  RTestAVLNode : TStreamRec = (
    ObjType : idTestAVLNode;
    VmtLink : Ofs(TypeOf(TTestAVLNode)^);
    Load    : @TTestAVLNode.Load;
    Store   : @TTestAVLNode.Store);

  RTestObject : TStreamRec = (
    ObjType : idTestObject;
    VmtLink : Ofs(TypeOf(TTestObject)^);
    Load    : @TTestObject.Load;
    Store   : @TTestObject.Store);

  RTestListNode : TStreamRec = (
    ObjType : idTestListNode;
    VmtLink : Ofs(TypeOf(TTestListNode)^);
    Load    : @TTestListNode.Load;
    Store   : @TTestListNode.Store);

  RTestDoubleNode : TStreamRec = (
    ObjType : idTestDoubleNode;
    VmtLink : Ofs(TypeOf(TTestDoubleNode)^);
    Load    : @TTestDoubleNode.Load;
    Store   : @TTestDoubleNode.Store);

  RTestStaticObject : TStreamRec = (
    ObjType : idTestStaticObject;
    VmtLink : Ofs(TypeOf(TTestStaticObject)^);
    Load    : @TTestStaticObject.Load;
    Store   : @TTestStaticObject.Store);

implementation

{****************************************************************************}
{ CreateAVLNode                                                              }
{****************************************************************************}
function CreateAVLNode (Key : String5; Index: Integer) : pointer;
var
  Item : PTestAVLNode;
begin
  Item := New(PTestAVLNode, Init(Key, Index));
  CreateAVLNode := Item;
end;

{****************************************************************************}
{ CreateBinaryNode                                                           }
{****************************************************************************}
function CreateBinaryNode (Key : String5; Index: Integer) : pointer;
var
  Item : PTestBinaryNode;
begin
  Item := New(PTestBinaryNode, Init(Key, Index));
  CreateBinaryNode := Item;
end;

{****************************************************************************}
{ CreateDoubleNode                                                           }
{****************************************************************************}
function CreateDoubleNode (Key : String5; Index : Integer) : Pointer;
var
  Item : PTestDoubleNode;
begin
  Item := New(PTestDoubleNode, Init(Key, Index));
  CreateDoubleNode := Item;
end;

{****************************************************************************}
{ CreateListNode                                                             }
{****************************************************************************}
function CreateListNode (Key : String5; Index : Integer) : Pointer;
var
  Item : PTestListNode;
begin
  Item := New(PTestListNode, Init(Key, Index));
  CreateListNode := Item;
end;

{****************************************************************************}
{ CreateNonDynamicTestObject                                                 }
{****************************************************************************}
procedure CreateNonDynamicTestObject (Key: String5; Index: Integer; var Data);
begin
  TTestObject(Data).Init(Key, Index);
end;

{****************************************************************************}
{ CreateNonDynamicTestRec                                                    }
{****************************************************************************}
procedure CreateNonDynamicTestRec (Key: String5; Index: Integer; var Data);
begin
  TTestRec(Data).Key := Key;
  TTestRec(Data).Index := Index;
end;

{****************************************************************************}
{ CreateNonDynamicTestStaticObject                                           }
{****************************************************************************}
procedure CreateNonDynamicTestStaticObject (Key: String5; Index: Integer;
  var Data);
begin
  TTestStaticObject(Data).Init(Key, Index);
end;

{****************************************************************************}
{ CreateStaticObject                                                         }
{****************************************************************************}
function CreateStaticObject (Key : String5; Index : Integer) : Pointer;
var
  Item : PTestStaticObject;
begin
  Item := New(PTestStaticObject, Init(Key, Index));
  CreateStaticObject := Item;
end;

{****************************************************************************}
{ CreateString                                                               }
{****************************************************************************}
function CreateString (Key : String5; Index : Integer) : Pointer;
begin
  CreateString := NewStr(Key);
end;

{****************************************************************************}
{ CreateTestObject                                                           }
{****************************************************************************}
function CreateTestObject (Key : String5; Index : Integer) : Pointer;
var
  Item : PTestObject;
begin
  Item := New(PTestObject, Init(Key, Index));
  Item^.Index := Index;
  CreateTestObject := Item;
end;

{****************************************************************************}
{ CreateTestRec                                                              }
{****************************************************************************}
function CreateTestRec (Key : String5; Index : Integer) : Pointer;
var
  Item : PTestRec;
begin
  New(Item);
  Item^.Key := Key;
  Item^.Index := Index;
  CreateTestRec := Item;
end;

{****************************************************************************}
{ TTestAVLNode object                                                        }
{****************************************************************************}
{****************************************************************************}
{ TTestAVLNode.Init                                                          }
{****************************************************************************}
constructor TTestAVLNode.Init(Key : String5; AIndex : Integer);
begin
  TStringAVLNode.Init(Key);
  Index := AIndex;
end;

{****************************************************************************}
{ TTestAVLNode.Load                                                          }
{****************************************************************************}
constructor TTestAVLNode.Load(var S: TStream);
begin
  if not TStringAVLNode.Load(S)
    then Fail;
  S.Read(Index, SizeOf(Index));
  if S.Status <> stOk
    then begin
           Done;
           Fail;
         end; { if }
end;

{****************************************************************************}
{ TTestAVLNode.Store                                                         }
{****************************************************************************}
procedure TTestAVLNode.Store(var S: TStream);
begin
  TStringAVLNode.Store(S);
  S.Write(Index, SizeOf(Index));
end;

{****************************************************************************}
{ TTestBinaryNode object                                                     }
{****************************************************************************}
{****************************************************************************}
{ TTestBinaryNode.Init                                                       }
{****************************************************************************}
constructor TTestBinaryNode.Init(Key : String5; AIndex : Integer);
begin
  TStringBinaryNode.Init(Key);
  Index := AIndex;
end;

{****************************************************************************}
{ TTestBinaryNode.Load                                                       }
{****************************************************************************}
constructor TTestBinaryNode.Load(var S: TStream);
begin
  if not TStringBinaryNode.Load(S)
    then Fail;
  S.Read(Index, SizeOf(Index));
  if S.Status <> stOk
    then begin
           Done;
           Fail;
         end; { if }
end;

{****************************************************************************}
{ TTestBinaryNode.Store                                                      }
{****************************************************************************}
procedure TTestBinaryNode.Store(var S: TStream);
begin
  TStringBinaryNode.Store(S);
  S.Write(Index, SizeOf(Index));
end;

{****************************************************************************}
{ TTestDoubleNode object                                                     }
{****************************************************************************}
{****************************************************************************}
{ TTestDoubleNode.Init                                                       }
{****************************************************************************}
constructor TTestDoubleNode.Init(Key : String5; AIndex : Integer);
begin
  if not TStringDoubleNode.Init(Key)
    then Fail;
  Index := AIndex;
end;

{****************************************************************************}
{ TTestDoubleNode.Load                                                       }
{****************************************************************************}
constructor TTestDoubleNode.Load(var S: TStream);
begin
  if not TStringDoubleNode.Load(S)
    then Fail;
  S.Read(Index, SizeOf(Index));
end;

{****************************************************************************}
{ TTestDoubleNode.Store                                                      }
{****************************************************************************}
procedure TTestDoubleNode.Store(var S: TStream);
begin
  TStringDoubleNode.Store(S);
  S.Write(Index, SizeOf(Index));
end;

{****************************************************************************}
{ TTestListNode object                                                       }
{****************************************************************************}
{****************************************************************************}
{ TTestListNode(Key                                                          }
{****************************************************************************}
constructor TTestListNode.Init(Key : String5; AIndex : Integer);
begin
  if not TStringListNode.Init(Key)
    then Fail;
  Index := AIndex;
end;

{****************************************************************************}
{ TTestListNode.Load                                                         }
{****************************************************************************}
constructor TTestListNode.Load(var S: TStream);
begin
  if not TStringListNode.Load(S)
    then Fail;
  S.Read(Index, SizeOf(Index));
end;

{****************************************************************************}
{ TTestListNode.Store                                                        }
{****************************************************************************}
procedure TTestListNode.Store(var S: TStream);
begin
  TStringListNode.Store(S);
  S.Write(Index, SizeOf(Index));
end;

{****************************************************************************}
{ TTestObject object                                                         }
{****************************************************************************}
{****************************************************************************}
{ TTestObject.Init                                                           }
{****************************************************************************}
constructor TTestObject.Init(Key : String5; AIndex : Integer);
begin
  if not TObject.Init
    then Fail;
  Text := NewStr(Key);
  Index := AIndex;
end;

{****************************************************************************}
{ TTestObject.Load                                                           }
{****************************************************************************}
constructor TTestObject.Load(var S: TStream);
begin
  if not TObject.Init
    then Fail;
  Text := S.ReadStr;
  S.Read(Index, SizeOf(Index));
end;

{****************************************************************************}
{ TTestObject.Done                                                           }
{****************************************************************************}
destructor TTestObject.Done;
begin
  DisposeStr(Text);
  TObject.Done;
end;

{****************************************************************************}
{ TTestObject.Store                                                          }
{****************************************************************************}
procedure TTestObject.Store(var S: TStream);
begin
  S.WriteStr(Text);
  S.Write(Index, SizeOf(Index));
end;

{****************************************************************************}
{ TTestStaticObject object                                                   }
{****************************************************************************}
{****************************************************************************}
{ TTestStaticObject.Init                                                     }
{****************************************************************************}
constructor TTestStaticObject.Init(Key : String5; AIndex : Integer);
begin
  if not TObject.Init
    then Fail;
  FillChar(Text, SizeOf(Text), #0);
  Text := Key;
  Index := AIndex;
end;

{****************************************************************************}
{ TTestStaticObject.Load                                                     }
{****************************************************************************}
constructor TTestStaticObject.Load(var S: TStream);
begin
  if not TObject.Init
    then Fail;
  S.Read(Text, SizeOf(Text));
  S.Read(Index, SizeOf(Index));
  if S.Status <> stOk
    then begin
           TObject.Done;
           Fail;
         end; { if }
end;

{****************************************************************************}
{ TTestStaticObject.Store                                                    }
{****************************************************************************}
procedure TTestStaticObject.Store(var S: TStream);
begin
  S.Write(Text, SizeOf(Text));
  S.Write(Index, SizeOf(Index));
end;

end.